HSCP - 9-digit code for Health and Social Care Partnerships (2016) of residence

HB - 9-digit code for health board of treatment based on boundaries as at 1st April 2019

library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5     v purrr   0.3.4
## v tibble  3.1.6     v dplyr   1.0.8
## v tidyr   1.2.0     v stringr 1.4.0
## v readr   2.1.2     v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(here)
## Warning: package 'here' was built under R version 4.1.3
## here() starts at C:/Users/mahri/OneDrive/CodeClan/rshiny_dashboard_project/Work In Progress/Demographics
library(readxl)
## Warning: package 'readxl' was built under R version 4.1.3
library(janitor)
## 
## Attaching package: 'janitor'
## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test
library(ggplot2)
library(lubridate)
## Warning: package 'lubridate' was built under R version 4.1.3
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
library(stringr)


Read In Data

covid_admissions_HB_agesex <- read_csv(here("../../raw_data/covid_data/hospital_admissions_hb_agesex_20220302.csv"))
## Rows: 43516 Columns: 12
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (8): HB, HBQF, AgeGroup, AgeGroupQF, Sex, SexQF, AdmissionType, Admissio...
## dbl (4): WeekEnding, NumberAdmissions, Average20182019, PercentVariation
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
covid_admissions_HB_simd <- read_csv(here("../../raw_data/covid_data/hospital_admissions_hb_simd_20220302.csv"))
## Rows: 21138 Columns: 9
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (4): HB, HBQF, AdmissionType, AdmissionTypeQF
## dbl (5): WeekEnding, SIMDQuintile, NumberAdmissions, Average20182019, Percen...
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
covid_admissions_HSCP_agesex <- read_csv(here("../../raw_data/covid_data/hospital_admissions_hscp_agesex_20220302.csv"))
## Rows: 91972 Columns: 11
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (7): HSCP, AgeGroup, AgeGroupQF, Sex, SexQF, AdmissionType, AdmissionTypeQF
## dbl (4): WeekEnding, NumberAdmissions, Average20182019, PercentVariation
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
covid_admissions_HSCP_simd <- read_csv(here("../../raw_data/covid_data/hospital_admissions_hscp_simd_20220302.csv"))
## Rows: 45998 Columns: 8
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (3): HSCP, AdmissionType, AdmissionTypeQF
## dbl (5): WeekEnding, SIMDQuintile, NumberAdmissions, Average20182019, Percen...
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.

Clean Names

covid_admissions_HB_agesex <- janitor::clean_names(covid_admissions_HB_agesex)
covid_admissions_HB_simd <- janitor::clean_names(covid_admissions_HB_simd)
covid_admissions_HSCP_agesex <- janitor::clean_names(covid_admissions_HSCP_agesex)
covid_admissions_HSCP_simd <- janitor::clean_names(covid_admissions_HSCP_simd)

Change week_ending column to a date and creating new day, month, year AND a month and year col

# Health Board x Age sex
covid_admissions_HB_agesex <- covid_admissions_HB_agesex %>%
  mutate(week_ending = ymd(week_ending))

covid_admissions_HB_agesex <- covid_admissions_HB_agesex %>%
  mutate(
    wk_ending_day = day(week_ending),
    wk_ending_month = month(week_ending, label = TRUE, abbr = FALSE),
    wk_ending_year = year(week_ending)
  ) %>% 
  unite(wk_ending_yr_month, 
        wk_ending_month, wk_ending_year, 
        remove = FALSE, 
        sep = " ")
covid_admissions_HB_agesex
#Health board x simd
covid_admissions_HB_simd <- covid_admissions_HB_simd %>%
  mutate(week_ending = ymd(week_ending))

covid_admissions_HB_simd <- covid_admissions_HB_simd %>%
  mutate(
    wk_ending_day = day(week_ending),
    wk_ending_month = month(week_ending, label = TRUE, abbr = FALSE),
    wk_ending_year = year(week_ending)
  ) %>% 
  unite(wk_ending_yr_month, 
        wk_ending_month, wk_ending_year, 
        remove = FALSE, 
        sep = " ")
covid_admissions_HB_simd
#HSCP x age sex
covid_admissions_HSCP_agesex <- covid_admissions_HSCP_agesex %>%
  mutate(week_ending = ymd(week_ending))

covid_admissions_HSCP_agesex <- covid_admissions_HSCP_agesex %>%
  mutate(
    wk_ending_day = day(week_ending),
    wk_ending_month = month(week_ending, label = TRUE, abbr = FALSE),
    wk_ending_year = year(week_ending)
  ) %>% 
  unite(wk_ending_yr_month, 
        wk_ending_month, wk_ending_year, 
        remove = FALSE, 
        sep = " ")
covid_admissions_HSCP_agesex
#HSCP x simd
covid_admissions_HSCP_simd <- covid_admissions_HSCP_simd %>%
  mutate(week_ending = ymd(week_ending))

covid_admissions_HSCP_simd <- covid_admissions_HSCP_simd %>%
  mutate(
    wk_ending_day = day(week_ending),
    wk_ending_month = month(week_ending, label = TRUE, abbr = FALSE),
    wk_ending_year = year(week_ending)
  ) %>% 
  unite(wk_ending_yr_month, 
        wk_ending_month, wk_ending_year, 
        remove = FALSE, 
        sep = " ")
covid_admissions_HSCP_simd


What are we working with?

Looking to see if i can join data? Probably??? All the HSPC corresponding health board values are S08000015 - s08000032 https://www.opendata.nhs.scot/dataset/geography-codes-and-labels/resource/944765d7-d0d9-46a0-b377-abb3de51d08e

The HB data set is all S08000015 - s08000032

covid_admissions_HB_agesex %>% 
  distinct(hb)
covid_admissions_HSCP_agesex %>% 
  distinct(hscp)

We only need ACUTE patients:

admission_type has: All, Emergency and Planned * all and emergency always have similar figures compared with planned.

covid_admissions_HB_agesex %>% 
  group_by(admission_type) %>% 
  summarise(total = n())
covid_admissions_HB_agesex %>% 
  group_by(age_group) %>% 
  summarise(total = n())
covid_admissions_HB_simd%>% 
  group_by(admission_type) %>% 
  summarise(total = n())
covid_admissions_HB_simd %>% 
  group_by(simd_quintile) %>% 
  summarise(total = n())
covid_admissions_HSCP_agesex%>% 
  group_by(admission_type) %>% 
  summarise(total = n())
covid_admissions_HSCP_agesex %>% 
  group_by(age_group) %>% 
  summarise(total = n())
covid_admissions_HSCP_simd%>% 
  group_by(admission_type) %>% 
  summarise(total = n())
covid_admissions_HSCP_simd %>% 
  group_by(simd_quintile) %>% 
  summarise(total = n())
covid_admissions_HB_agesex <- covid_admissions_HB_agesex %>% 
  filter(admission_type == "Emergency")

covid_admissions_HB_simd <- covid_admissions_HB_simd %>% 
  filter(admission_type == "Emergency")

covid_admissions_HSCP_agesex <- covid_admissions_HSCP_agesex %>% 
  filter(admission_type == "Emergency")

covid_admissions_HSCP_simd <- covid_admissions_HSCP_simd %>% 
  filter(admission_type == "Emergency")

ANd we don’t need ALL ages either…

covid_admissions_HB_agesex <- covid_admissions_HB_agesex %>% 
  filter(age_group != "All ages")

covid_admissions_HSCP_agesex <- covid_admissions_HSCP_agesex %>% 
  filter(age_group != "All ages")


HEALTH BOARD - sex and age

HB - Age - Total Covid admissions

covid_ads_HB_age <- covid_admissions_HB_agesex %>% 
  group_by(wk_ending_yr_month, age_group) %>%
  summarise(total_admissions = n())
## `summarise()` has grouped output by 'wk_ending_yr_month'. You can override
## using the `.groups` argument.
covid_ads_HB_age
# April 2020 is shown first and ages are a mess. So:

covid_ads_HB_age %>% 
  distinct(wk_ending_yr_month)
dates <- c("January 2020", "February 2020", "March 2020", "April 2020", "May 2020", 
           "June 2020", "July 2020", "August 2020", "September 2020", 
           "October 2020", "November 2020", "December 2020", "January 2021", 
           "February 2021", "March 2021", "April 2021", "May 2021", "June 2021",
           "July 2021", "August 2021", "September 2021", "October 2021", 
           "November 2021", "December 2021", "January 2022", "February 2022")

summer_dates <- c("April 2020", "May 2020", "June 2020", "July 2020", 
                  "August 2020", "September 2020", "April 2021", "May 2021", 
                  "June 2021", "July 2021", "August 2021", "September 2021")

winter_dates <- c("January 2020", "February 2020", "March 2020", "October 2020",
                  "November 2020", "December 2020", "January 2021", 
                  "February 2021", "March 2021", "October 2021", 
                  "November 2021", "December 2021", "January 2022", 
                  "February 2022")
  
covid_ads_HB_age %>% 
  distinct(age_group)
# USE THIS
# covid_admissions_HB_agesex %>% 
#   mutate(age_group = fct_relevel(age_group, "Under 5", "5 - 14", "15 - 44", 
#                                  "45 - 64", "65 - 74", "75 - 84", "85 and over"))
covid_ads_HB_age %>% 
  mutate(age_group = fct_relevel(age_group, 
                                 "Under 5", "5 - 14", "15 - 44", 
                                 "45 - 64", "65 - 74", "75 - 84", 
                                 "85 and over")) %>%
  ggplot()+
  aes(x = wk_ending_yr_month, 
      y = total_admissions, 
      group = age_group, 
      colour = age_group)+
  scale_x_discrete(limits = dates) +
  geom_point()+
  labs(x = "Month",
       y = "Total COVID admissions",
       title = "Total COVID admissions per month by age group",
       subtitle = "January, 2020 to February",
       colour = "Age Group") +
  theme_bw()+
  theme(axis.text.x = element_text(angle = 45, hjust = 0.9))

The above to see if there’s difference in age groups and seasons * Winter = Q4 and Q1

highlight_winter_HB_agesex <- covid_admissions_HSCP_agesex %>% 
  filter(str_detect(wk_ending_yr_month, 
                    "October|November|December|January|February|March"))

highlight_summer_HB_agesex <- covid_admissions_HSCP_agesex %>% 
  filter(str_detect(wk_ending_yr_month, 
                    "April|May|June|July|August|September"))
covid_ads_HB_age %>% 
  mutate(age_group = fct_relevel(age_group, 
                                 "Under 5", "5 - 14", "15 - 44", 
                                 "45 - 64", "65 - 74", "75 - 84", 
                                 "85 and over")) %>%
  ggplot()+
  aes(x = wk_ending_yr_month, 
      y = total_admissions, 
      group = age_group, 
      fill = age_group)+
  scale_x_discrete(limits = dates) +
  geom_col()+
  facet_wrap(~age_group)+
  labs(x = "Month",
       y = "Total COVID admissions",
       title = "Total COVID admissions per month by age group",
       subtitle = "January, 2020 - February 2022",
       fill = "Age Group") +
  theme_bw()+
  theme(axis.text.x = element_text(angle = 45, hjust = 0.9))

THE ABOVE BUT WINTER vs SUMMER

covid_ads_HB_age_highlight_summer <- highlight_summer_HB_agesex %>% 
  group_by(wk_ending_yr_month, age_group) %>%
  summarise(total_admissions = n())
## `summarise()` has grouped output by 'wk_ending_yr_month'. You can override
## using the `.groups` argument.
covid_ads_HB_age_highlight_summer
covid_ads_HB_age_highlight_summer %>% 
  mutate(age_group = fct_relevel(age_group, 
                                 "Under 5", "5 - 14", "15 - 44", 
                                 "45 - 64", "65 - 74", "75 - 84", 
                                 "85 and over")) %>%
  ggplot()+
  aes(x = wk_ending_yr_month, 
      y = total_admissions, 
      group = age_group, 
      fill = age_group)+
  scale_x_discrete(limits = summer_dates) +
  geom_col()+
  facet_wrap(~age_group)+
  labs(x = "Month",
       y = "Total COVID admissions",
       title = "Total COVID admissions per month by age group",
       subtitle = "January, 2020 to February",
       fill = "Age Group") +
  theme_bw()+
  theme(axis.text.x = element_text(angle = 45, hjust = 0.9))

WINTER

covid_ads_HB_age_highlight_winter <- highlight_winter_HB_agesex %>% 
  group_by(wk_ending_yr_month, age_group) %>%
  summarise(total_admissions = n())
## `summarise()` has grouped output by 'wk_ending_yr_month'. You can override
## using the `.groups` argument.
covid_ads_HB_age_highlight_winter
covid_ads_HB_age_highlight_winter %>% 
  mutate(age_group = fct_relevel(age_group, 
                                 "Under 5", "5 - 14", "15 - 44", 
                                 "45 - 64", "65 - 74", "75 - 84", 
                                 "85 and over")) %>%
  ggplot()+
  aes(x = wk_ending_yr_month, 
      y = total_admissions, 
      group = age_group, 
      fill = age_group)+
  scale_x_discrete(limits = winter_dates) +
  geom_col()+
  facet_wrap(~age_group)+
  labs(x = "Month",
       y = "Total COVID admissions",
       title = "Total COVID admissions per month by age group",
       subtitle = "January, 2020 to February",
       fill = "Age Group") +
  theme_bw()+
  theme(axis.text.x = element_text(angle = 45, hjust = 0.9))


HB - Age - Weekly COVID admissions agains the average admissions in 2018 & 19

covid_admissions_HB_agesex %>% 
  mutate(age_group = fct_relevel(age_group, 
                                 "Under 5", "5 - 14", "15 - 44", 
                                 "45 - 64", "65 - 74", "75 - 84", 
                                 "85 and over")) %>%
  group_by(age_group) %>% 
  ggplot()+
  aes(x = number_admissions, 
      y = average20182019, 
      colour = age_group)+
  geom_point() +
  labs(x = "Weekly number of COVID admissions",
       y = "Average weekly admissions to hospital in 2018-2019",
       title = "Weekly COVID admissions per age group against the average weekly 
       admissions in previous years",
       subtitle = "COVID: January, 2020 to February, 2022 / Previous years: 2018 - 2019",
       colour = "Age Group") +
  theme_bw()+
  theme(axis.text.x = element_text(angle = 45, hjust = 0.9))

The above just looking to see if there are differences in age groups

covid_admissions_HB_agesex %>% 
  mutate(age_group = fct_relevel(age_group, 
                                 "Under 5", "5 - 14", "15 - 44", 
                                 "45 - 64", "65 - 74", "75 - 84", 
                                 "85 and over")) %>% 
  group_by(age_group) %>% 
  ggplot()+
  aes(x = number_admissions, 
      y = average20182019, 
      colour = age_group)+
  geom_point() +
  facet_wrap(~age_group) +
  labs(x = "Weekly number of COVID admissions",
       y = "Average weekly admissions to hospital in 2018-2019",
       title = "Weekly COVID admissions per age group against the average weekly 
       admissions in previous years",
       subtitle = "COVID: January, 2020 - February, 2022 / Previous years: 2018 - 2019",
       colour = "Age Group") +
  theme_bw()+
  theme(axis.text.x = element_text(angle = 45, hjust = 0.9))

HB - Sex - Average Covid Admissions vs Average 2018 and 2019 admissions

covid_admissions_HB_sex <- covid_admissions_HB_agesex %>% 
  filter(sex != "All") %>% 
  group_by(week_ending, sex) %>% 
  summarise(total_admissions_for_week_ending = n())
## `summarise()` has grouped output by 'week_ending'. You can override using the
## `.groups` argument.
covid_admissions_HB_sex
covid_admissions_HB_sex %>% 
  ggplot()+
  aes(x = week_ending, 
      y = total_admissions_for_week_ending,
      colour = sex)+
  geom_line()+
  labs(title = "I AM AWARE THIS IS AWFUL")

covid_admissions_HB_sex %>% 
  ggplot()+
  aes(x = week_ending, 
      y = total_admissions_for_week_ending,
      fill = sex)+
  geom_col(position = "dodge")+
  labs(title = "I AM AWARE THIS IS AWFUL")

covid_admissions_HB_agesex %>% 
  filter(sex != "All") %>% 
  group_by(sex) %>% 
  ggplot()+
  aes(x = number_admissions, 
      y = average20182019, 
      colour = sex)+
  geom_point()+
  labs(x = "Weekly number of COVID admissions",
       y = "Average weekly admissions to hospital in 2018-2019",
       title = "Weekly COVID admissions per sex against the average weekly 
       admissions in previous years",
       subtitle = "COVID: January, 2020 to February, 2022 / Previous years: 2018 - 2019",
       colour = "Sex") +
  theme_bw()+
  theme(axis.text.x = element_text(angle = 45, hjust = 0.9))

HEALTH BOARD - SIMD

HB - SIMD - Average Covid Admissions vs Average 2018 and 2019 admissions

HSCP - sex and age

HSCP - Age - Average Covid Admissions vs Average 2018 and 2019 admissions

  • Take out age group “all”

HSCP - Sex - Average Covid Admissions vs Average 2018 and 2019 admissions

HSCP - SIMD

HSCP - SIMD - Average Covid Admissions vs Average 2018 and 2019 admissions